home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
grsear20.zip
/
GRINITUN.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
14KB
|
404 lines
unit grinitun;
{ Author:
7/17/88 Michael Shunfenthal Compuserve ID [76320,122]
PROGRAM FUNCTION
Determine the adapter type, and search for the driver file. For more
info, refer to the file GRINIT.DOC.
}
interface
uses dos, crt, graph;
type debugrange = 0..2;
function grsearch
(environvar : string; var GraphDriver : integer;
var dirstring : string; grdebug : debugrange) : boolean;
{ Explanation:
function true: driver found and adapter initialized
false: an error prevents graphics initialization
environvar: contains the desired environment variable name to be
examined for the list of directories in the format of the
path variable. if null, ('') PATH is the default.
GraphDriver: graphics driver found by DetectGraph
dirstring: contains the path to the required driver file
grdebug: 0 = no display. use only function value to indicate status
1 = display errors only
2 = verbose: display errors, list the environment and
the directories in the specified environment variable
}
implementation
function grsearch;
const
{ max number of directories in the path }
MaxDirectories = 20;
{ max length of each directory string }
MaxDirLength = 64;
{ max space searched for environment }
MaxEnvironSpace = 32000;
{ maximum length of the environment variable }
MaxVarLength = 1000;
type
bytepatharray = Array [1..MaxDirectories, 1..MaxDirLength] of byte;
maxdirtype = 0..MaxDirectories;
var
GraphMode : integer;
graphstatus : integer;
bgifile : string [8];
varfound : boolean;
procedure GraphicsDetermine;
{ detect and return the adapter type, then
define the bgi file to be found }
begin
DetectGraph(GraphDriver, GraphMode );
case GraphDriver of { set the BGI file to be found }
Reserved,
CGA : bgifile := 'CGA';
EGA, EGA64, EGAMono,
MCGA, VGA: bgifile := 'EGAVGA';
Hercmono : bgifile := 'HERC';
ATT400 : bgifile := 'ATT';
PC3270 : bgifile := 'PC3270';
end;
graphstatus := GraphResult;
if graphstatus <> grOk
then { test result of graphics operation }
begin
if (grdebug=1) or (grdebug=2)
then
writeln('DetectGraph error: ', GraphErrorMsg(GraphDriver));
Halt(1);
end;
end; { GraphicsDetermine }
procedure SearchEnvironment ( var dircount : maxdirtype;
var dirlist : bytepatharray );
{ read the environment and extract the directory list }
var
Segment : Integer; { the two parts of an address }
offset, { index into environment space }
{ offset where the variable begins }
offsetvarstart : 0 .. MaxEnvironSpace;
procedure ReadEnvironment;
{ read the environment area, searching for variables delimited by a null }
function locatevariable : boolean;
{ search for the specified variable, or 'PATH'}
label 1000, 2000;
var
index : integer;
begin
{prepare passed parameter for use: substitute 'PATH' if null, or
trim trailing spaces and convert to uppercase }
if length( environvar)>0
then
for index := 1 to length (environvar) do
if environvar[index]=' '
then
begin
environvar := copy(environvar,1,length(environvar)-1);
goto 1000
end
else
environvar[index] := upcase( environvar[index])
else
environvar := 'PATH';
{ compare each character in the passed variable to the character
in the environment }
1000: for index := 1 to length (environvar) do
if Mem[Segment:offset-1+index] <> ord( environvar[index])
then goto 2000;
{ mark one more than the first character after the variable to
skip over the '=' sign }
offsetvarstart:=offset + length (environvar) +1;
locatevariable := true;
exit;
{ mismatch: error exit }
2000: locatevariable := false;
end; { locatevariable }
Begin { ReadEnvironment }
offset := 0; { set initial offsets }
if grdebug=2
then
begin
ClrScr;
writeln('The environment variables: ')
end;
While (offset < MaxEnvironSpace) do
begin
{ call locatevariable to see if it is the first variable
in the environment }
if offset = 0
then
varfound := locatevariable;
if Mem[Segment:offset] = 0
then
begin
if Mem[Segment:offset+1] = 0
then
begin
{ two nulls in a row indicate the end of the
environment }
if grdebug=2
then
begin
writeln;
writeln('The DOS environment is ',offset,
' bytes long.', environvar,
' located at offset: ', offsetvarstart)
end;
exit
end
else
{ a single null indicates the end of one variable,
so the call to locatevariable will not find one
as part of another call only if the variable has
not already been found}
begin
offset := offset + 1;
if not varfound then varfound := locatevariable;
offset := offset - 1;
if grdebug=2
then
writeln
end
end
else { not a null }
begin
if grdebug=2
then
write(chr(Mem[Segment:offset]));
end;
offset := offset + 1;
end; { end while loop }
End; { ReadEnvironment }
Procedure StorePath;
{ search for each directory delimited by a ';', store it in an array
and filter non-allowed characters }
var
dirndx : maxdirtype; { directory counter }
pc : 0..MaxDirLength; { when searching: character-in-path counter }
offsetvarctr : integer; { counter into the the variable's list of dirs }
Begin
pc := 0;
dircount := 1;
offsetvarctr := offsetvarstart;
While offsetvarctr< offsetvarstart+MaxVarLength do
begin
if Mem[Segment:offsetvarctr]=0
then
{ null found, so search is complete force exit from loop }
offsetvarctr := offsetvarstart+MaxVarLength + 1
else
if Mem[Segment:offsetvarctr] in
{ are they allowable chars? }
[33..41, { punctuation }
44..59, 61, { punctuation, numbers, ';' }
64..90, 92, { uppercase alphabetics, '\' }
97..122] { lowercase alphabetics }
then
if Mem[Segment:offsetvarctr]=59
then { the PATH delim }
begin
{ end of one subdirectory, so
reset char count, increment dircount }
dircount := dircount + 1;
pc := 0;
if dircount >= MaxDirectories
then
begin
if (grdebug=1) or (grdebug=2)
then
writeln(
'Too many Paths encountered... exiting'
);
Halt(1)
{ to DOS with ErrorLevel set to 1 }
end;
end
else
begin
{ save the path character in an array }
pc := pc+1;
dirlist[dircount][pc] := Mem[Segment:
offsetvarctr];
end;
offsetvarctr := offsetvarctr + 1;
end;
end; { StorePath }
Procedure ListPath;
{ display each directory in the path }
var
dirndx : maxdirtype; { directory counter }
pc : integer; { count characters in the array }
begin
writeln;
writeln('Number of directories: ', dircount,
'. The list of directories:');
If dircount >= 1
then
For dirndx:=1 to dircount do
begin
pc := 1;
While (pc < MaxDirLength) and
( dirlist[dirndx][pc]<>0) do
begin
{ it is a printable char }
write(chr(dirlist[dirndx][pc]));
pc := pc + 1
end;
writeln; { a new line }
end { dirndx loop }
else
writeln('No PATH variable in the environment');
end; { ListPath }
Begin {searchenvironment}
{segment where the environment starts }
Segment := MemW[PrefixSeg:$2C];
ReadEnvironment;
if varfound
then
begin
StorePath;
if grdebug=2
then
ListPath;
end
else
if (grdebug=1) or (grdebug=2)
then
writeln ('Environment variable: ', environvar,' not found');
End; {searchenvironment}
procedure BgiFind; { search for the given bgifile }
label
1000;
var
listdirbyte : bytepatharray;
maxdirs, countdirs : maxdirtype;
countbyte : integer;
filerecord : searchrec;
begin { bgifind }
{ first search for bgi file in the default directory.
if not found, continue the search by sequentially testing each
directory in array listdirbyte }
findfirst ( bgifile+'.bgi', anyfile, filerecord);
if doserror = 0
then
begin
if grdebug=2
then
writeln ( 'Found in default directory: ', bgifile +
'.bgi');
exit;
end
else
begin
{ initialize the array before using it }
for maxdirs := 1 to MaxDirectories do
for countbyte := 1 to MaxDirLength do
listdirbyte[maxdirs,countbyte] := 0;
searchenvironment (maxdirs, listdirbyte);
{ convert the byte array into an input for findfirst }
if varfound
then
for countdirs := 1 to maxdirs do
begin
dirstring := '';
for countbyte := 1 to MaxDirLength do
begin
{ starting with the left end of the byte array, stuff the
character equivalent into the string variable dirstring
until the first null is reached. At that byte, substitute
a '\' if the last character wasn't already a '\' }
if listdirbyte[countdirs, countbyte] <> 0
then
dirstring := dirstring +
chr (listdirbyte[countdirs, countbyte])
else {null byte: end of directory path }
if copy (dirstring, length (
dirstring), 1)<>'\'
then
begin
dirstring := dirstring + '\';
goto 1000;
end;
end;
1000: findfirst ( dirstring+bgifile+'.bgi',
anyfile, filerecord);
if doserror = 0
then
begin
if grdebug=2
then
writeln ( 'Found: ', dirstring+
bgifile+'.bgi');
exit;
end
else
if grdebug=2
then
writeln ( 'Did not find: ',
dirstring+bgifile+'.bgi',
' Dos error: ', doserror );
end;
end; { look in default directory }
end; { bgifind }
begin {main procedure}
GraphicsDetermine;
bgifind;
if varfound
then
begin
{ wait to allow observing the screen }
if grdebug=2
then
begin
writeln('Press <return>');
readln
end;
InitGraph (Graphdriver, Graphmode, dirstring);
graphstatus := GraphResult;
if graphstatus <> grOk
then
begin
if (grdebug=1) or (grdebug=2)
then
writeln( 'InitGraph error: ', GraphErrorMsg(GraphDriver));
grsearch := false;
end
else
grsearch := true;
end
else
grsearch := false;
end; {main procedure}
begin
{initialization}
end.